home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr35 / pcbvpurg.zip / PCBVPURG.BAS < prev    next >
BASIC Source File  |  1993-06-10  |  5KB  |  168 lines
  1. '+--------------------------[ PCBVPURG Ver 1.00 ]----------------------------+
  2. '|  Written By Gary Meeker 06/10/93                        Updated   /  /    |
  3. '|  SYSOP: SHARP Technical Support Line BBS               Lawrenceville, GA  |
  4. '|         (404) 962-1788                          300-14400 Baud. 24 Hours  |
  5. '+---------------------------------------------------------------------------+
  6. 'V1.00  06/10/93 - Initial Release
  7. '
  8.  
  9. DEFINT A-Z
  10.  
  11. '   QuickPack Declarations
  12. DECLARE FUNCTION TrapInt% (Value%, LoLimit%, HiLimit%)
  13. DECLARE SUB KillFile (FileName$)
  14. DECLARE SUB NameFile (OldName$, NewName$)
  15.  
  16. '   PDQ Declarations
  17. DECLARE FUNCTION PDQExist% (FileSpec$)
  18. DECLARE FUNCTION PDQParse$ (Work$)
  19. DECLARE SUB SetDelimitChar (Char)
  20.  
  21. '   ProBas Declarations
  22.  
  23. '   Myown Declarations
  24. DECLARE FUNCTION EndString(Temp$, EndCh$)
  25. DECLARE FUNCTION FindLastCh(St$, BYVAL Ch)
  26. DECLARE SUB DEC ALIAS "_dec" (IntVar%)
  27. DECLARE SUB DecStep(IntVar%, StepVar%)
  28. DECLARE SUB INC ALIAS "_inc" (IntVar%)
  29. DECLARE SUB IncStep(IntVar%, StepVar%)
  30.  
  31. '   Local Declarations
  32. DECLARE FUNCTION EndChar$(St$, EndCh$)
  33. DECLARE FUNCTION MakeExt$(St$, Ext$)
  34. DECLARE FUNCTION FindIndex%(IndexFiles$, IndexLetter$)
  35.  
  36. ' $INCLUDE: 'PCBTYPES.INC'
  37.  
  38. 'TYPE PCBNDXRECORD
  39. '   Index AS INTEGER
  40. '   UserName As STRING * 25
  41. 'END TYPE
  42.  
  43. DIM SHARED Phone$(1 TO 256), User$(1 TO 256), Dat$(1 TO 256), UserNo(1 TO 256)
  44. DIM UserName AS STRING * 25
  45. Q$ = CHR$(34)
  46. Q2$ = Q$ + "," + Q$
  47.  
  48. PRINT "PCBVPurg Ver 1.00 - Copyright 1993 Gary Meeker"
  49.  
  50. SetDelimitChar 32
  51. CM$ = UCASE$(COMMAND$)
  52. PCBVFile$       = PDQParse$(CM$)
  53. OutputFile$     = MakeExt$(PCBVFile$, "$$$")
  54. OldFile$        = MakeExt$(PCBVFile$, "BAK")
  55. USERSIndexPath$ = EndChar$(PDQParse$(CM$), "\")
  56.  
  57. IF NOT PDQExist(PCBVFile$) THEN
  58.    PRINT PCBVFile$; " not found!"
  59.    GOTO ErrorExit
  60. ELSEIF NOT PDQExist(USERSIndexPath$ + "PCBNDX.A") THEN
  61.    PRINT "Invalid Index file path"
  62.    GOTO ErrorExit
  63. END IF
  64.  
  65. PRINT "Purging "; PCBVFile$
  66. OPEN PCBVFile$ FOR INPUT ACCESS READ SHARED AS #1
  67. OPEN OutputFile$ FOR OUTPUT ACCESS WRITE SHARED AS #2
  68.    DO WHILE NOT EOF(1)
  69.       PRINT "-";
  70.       Count = 0
  71.       DO WHILE Count < 256 AND NOT EOF(1)
  72.          INC Count
  73.          INPUT #1, Phone$(Count), User$(Count), Dat$(Count)
  74.       LOOP
  75.       PRINT "|";
  76.       Count2 = 0
  77.       DO WHILE Count > 0
  78.          INC Count2
  79.          LSET UserName$ = User$(Count2)
  80.          UserNo(Count2) = FindIndex%(USERSIndexPath$ + "PCBNDX.", UserName$)
  81.          DEC Count
  82.       LOOP
  83.       PRINT "/";
  84.       Count = 0
  85.       DO WHILE Count2 > 0
  86.          INC Count
  87.          IF UserNo(Count) > 0 THEN
  88.             PRINT #2, Q$; Phone$(Count); Q2$; User$(Count); Q2$; Dat$(Count); Q$
  89.          END IF
  90.          DEC Count2
  91.       LOOP
  92.    LOOP
  93. CLOSE #2
  94. CLOSE #1
  95. PRINT
  96.  
  97. KillFile OldFile$
  98. NameFile PCBVFile$, OldFile$
  99. NameFile OutputFile$, PCBVFile$
  100. PRINT "Done"
  101.  
  102. ErrorExit:
  103. END
  104.  
  105. FUNCTION EndChar$(St$, EndCh$) STATIC
  106.    Temp$ = RTRIM$(ST$)
  107.    IF (LEN(Temp$) = 0) OR EndString(Temp$, EndCh$) THEN
  108.       EndChar$ = Temp$
  109.    ELSE
  110.       EndChar$ = Temp$ + EndCh$
  111.    END IF
  112. END FUNCTION
  113.  
  114. FUNCTION MakeExt$(St$, Ext$) STATIC
  115.    ExtPos = FindLastCh(St$, 46)
  116.    IF ExtPos THEN
  117.       MakeExt$ = LEFT$(St$, ExtPos) + Ext$
  118.    ELSE
  119.       MakeExt$ = RTRIM$(St$) + "." + Ext$
  120.    END IF
  121. END FUNCTION
  122.  
  123.  
  124. FUNCTION FindIndex%(IndexFiles$, UserName$) STATIC
  125.    DIM PCBNDX AS PCBNDXRECORD
  126.    IndexLen = LEN(PCBNDX)
  127.    IndexFile$ = IndexFiles$ + CHR$(TrapInt(ASC(LEFT$(UserName$, 1)), 65, 90))
  128.    IndexFileNo = FREEFILE
  129.    FindIndex = -1
  130.    IF PDQExist(IndexFile$) THEN
  131.       OPEN IndexFile$ FOR RANDOM AS #IndexFileNo LEN = Indexlen
  132.          Indexes = LOF(IndexFileNo) \ IndexLen
  133.          Test = 0
  134.          IF Indexes < 1 THEN
  135.          ELSE
  136.             Jump = Indexes \ 2 + (Indexes MOD 2): Match = Jump
  137.             DO
  138.                Test = Test - (Jump = 1)
  139.                Jump = Jump \ 2 + (Jump MOD 2)
  140.                Match = TrapInt(Match, 1, Indexes)
  141.                GET #IndexFileNo, Match, PCBNDX
  142.                IF UserName$ = PCBNDX.UserName$ THEN
  143.                   FindIndex = PCBNDX.Index
  144.                   EXIT DO
  145.                ELSEIF UserName$ < PCBNDX.UserName$ THEN
  146.                   DecStep Match, Jump
  147.                ELSE
  148.                   IncStep Match, Jump
  149.                END IF
  150.                IF Test > 1 THEN
  151.                   EXIT DO
  152.                END IF
  153.             LOOP
  154.          END IF
  155.       CLOSE #IndexFileNo
  156.    END IF
  157. END FUNCTION
  158.  
  159. 'This file was last compiled with:
  160. 'BC PCBVPURG.BAS  /o /s;
  161. 'LINK PCBVPURG+
  162. '     C:\QB\LIB\_NOERROR C:\QB\LIB\_NOFIELD C:\QB\LIB\_NOREAD C:\QB\LIB\_NOVAL+
  163. '     /ex /nod /noe /packcode /far
  164. '
  165. '     nul
  166. '     C:\QB\LIB\SCREEN C:\QB\LIB\MYOWN C:\QB\LIB\QPPRO C:\QB\LIB\PDQFP
  167. '
  168.